unit StorageDevice;

interface

uses
  Windows, Classes, CfgMgr32, SetupApi;

type
  PIO_Port = ^TIO_Port;

  TIO_Port = record
    BasePort: Word;
    AltPort: Word;
  end;

function EnumStorIOPort(var IOPortList: TList): Boolean; overload;

function EnumStorIOPort(var IOPortList: array of TIO_Port): Boolean; overload;

implementation

function EnumStorIOPort(var IOPortList: TList): Boolean;
var
  PIOPort: PIO_Port;
  h_DevInfo: HDEVINFO;
  spDevInfoData: SP_DEVINFO_DATA;
  wIndex: DWORD;
  pBuf: PByte;
  ulSize: ULONG;
  dwDevInst: DevInst;
  dwResType: DWORD;
  cmRet: CONFIGRET;
  firstLogConf: LOG_CONF;
  nextLogConf: LOG_CONF;
  rdPrevResDes: RES_DES;
  IODes: IO_DES;
  uBasePort: Int64;
  uAltPort: Int64;
  uBase: Int64;
  fStorPort: BOOL;
begin
  Result := False;
  h_DevInfo := SetupDiGetClassDevs(nil, nil, 0, DIGCF_PRESENT or DIGCF_ALLCLASSES or DIGCF_PROFILE);
  if h_DevInfo = INVALID_HANDLE_VALUE then
    Exit;
  wIndex := 0;
  ZeroMemory(@spDevInfoData, SizeOf(SP_DEVINFO_DATA));
  spDevInfoData.cbSize := SizeOf(SP_DEVINFO_DATA);
  while SetupDiEnumDeviceInfo(h_DevInfo, wIndex, @spDevInfoData) do
  begin
    firstLogConf := 0;
    nextLogConf := 0;
    dwDevInst := spDevInfoData.DEVINST;
    dwResType := ResType_IO;
    cmRet := CM_Get_First_Log_Conf(@firstLogConf, dwDevInst, ALLOC_LOG_CONF);
    if cmRet <> CR_SUCCESS then
    begin
      cmRet := CM_Get_First_Log_Conf(@firstLogConf, dwDevInst, BOOT_LOG_CONF);
      if cmRet <> CR_SUCCESS then
      begin
        Inc(wIndex);
        Continue;
      end;
    end;
    cmRet := CM_Get_Next_Res_Des(@nextLogConf, firstLogConf, dwResType, nil, 0);
    if cmRet <> CR_SUCCESS then
    begin
      CM_Free_Res_Des_Handle(firstLogConf);
      Inc(wIndex);
      Continue;
    end;
    fStorPort := False;
    uBasePort := 0;
    while True do
    begin
      ulSize := 0;
      cmRet := CM_Get_Res_Des_Data_Size(@ulSize, nextLogConf, 0);
      if cmRet <> CR_SUCCESS then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        Break;
      end;
      pBuf := AllocMem(ulSize);
      if pBuf = nil then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        Break;
      end;
      cmRet := CM_Get_Res_Des_Data(nextLogConf, pBuf, ulSize, 0);
      if cmRet <> CR_SUCCESS then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        FreeMemory(pBuf);
        Break;
      end;
      ZeroMemory(@IODes, SizeOf(IODes));
      CopyMemory(@IODes, pBuf, SizeOf(IODes));
      uBase := IODes.IOD_Alloc_Base;
      if fStorPort = True then
      begin
        fStorPort := False;
        uAltPort := IODes.IOD_Alloc_End - 1;
        if uBasePort = $170 then
          uAltPort := $376;
        if uBasePort = $1F0 then
          uAltPort := $3F6;
        //**********************************************************************
        New(PIOPort);
        PIOPort.BasePort := uBasePort;
        PIOPort.AltPort := uAltPort;
        IOPortList.Add(PIOPort);
        //**********************************************************************
      end
      else
        uAltPort := IODes.IOD_Alloc_End;
      if uAltPort - uBase = 7 then
      begin
        fStorPort := True;
        uBasePort := uBase;
      end;
      rdPrevResDes := 0;
      cmRet := CM_Get_Next_Res_Des(@rdPrevResDes, nextLogConf, dwResType, nil, 0);
      FreeMemory(pBuf);
      if cmRet <> CR_SUCCESS then
        Break
      else
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        nextLogConf := rdPrevResDes;
      end;
    end;
    CM_Free_Res_Des_Handle(nextLogConf);
    Inc(wIndex);
  end;
  Result := True;
end;

function EnumStorIOPort(var IOPortList: array of TIO_Port): Boolean;
var
  nIdx: Integer;
  h_DevInfo: HDEVINFO;
  spDevInfoData: SP_DEVINFO_DATA;
  wIndex: DWORD;
  pBuf: PByte;
  ulSize: ULONG;
  dwDevInst: DevInst;
  dwResType: DWORD;
  cmRet: CONFIGRET;
  firstLogConf: LOG_CONF;
  nextLogConf: LOG_CONF;
  rdPrevResDes: RES_DES;
  IODes: IO_DES;
  uBasePort: Int64;
  uAltPort: Int64;
  uBase: Int64;
  fStorPort: BOOL;
begin
  Result := False;
  nIdx := 0;
  h_DevInfo := SetupDiGetClassDevs(nil, nil, 0, DIGCF_PRESENT or DIGCF_ALLCLASSES or DIGCF_PROFILE);
  if h_DevInfo = INVALID_HANDLE_VALUE then
    Exit;
  wIndex := 0;
  ZeroMemory(@spDevInfoData, SizeOf(SP_DEVINFO_DATA));
  spDevInfoData.cbSize := SizeOf(SP_DEVINFO_DATA);
  while SetupDiEnumDeviceInfo(h_DevInfo, wIndex, @spDevInfoData) do
  begin
    firstLogConf := 0;
    nextLogConf := 0;
    dwDevInst := spDevInfoData.DEVINST;
    dwResType := ResType_IO;
    cmRet := CM_Get_First_Log_Conf(@firstLogConf, dwDevInst, ALLOC_LOG_CONF);
    if cmRet <> CR_SUCCESS then
    begin
      cmRet := CM_Get_First_Log_Conf(@firstLogConf, dwDevInst, BOOT_LOG_CONF);
      if cmRet <> CR_SUCCESS then
      begin
        Inc(wIndex);
        Continue;
      end;
    end;
    cmRet := CM_Get_Next_Res_Des(@nextLogConf, firstLogConf, dwResType, nil, 0);
    if cmRet <> CR_SUCCESS then
    begin
      CM_Free_Res_Des_Handle(firstLogConf);
      Inc(wIndex);
      Continue;
    end;
    fStorPort := False;
    uBasePort := 0;
    while True do
    begin
      ulSize := 0;
      cmRet := CM_Get_Res_Des_Data_Size(@ulSize, nextLogConf, 0);
      if cmRet <> CR_SUCCESS then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        Break;
      end;
      pBuf := AllocMem(ulSize);
      if pBuf = nil then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        Break;
      end;
      cmRet := CM_Get_Res_Des_Data(nextLogConf, pBuf, ulSize, 0);
      if cmRet <> CR_SUCCESS then
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        FreeMemory(pBuf);
        Break;
      end;
      ZeroMemory(@IODes, SizeOf(IODes));
      CopyMemory(@IODes, pBuf, SizeOf(IODes));
      uBase := IODes.IOD_Alloc_Base;
      if fStorPort = True then
      begin
        fStorPort := False;
        uAltPort := IODes.IOD_Alloc_End - 1;
        if uBasePort = $170 then
          uAltPort := $376;
        if uBasePort = $1F0 then
          uAltPort := $3F6;
        //**********************************************************************
        IOPortList[nIdx].BasePort := uBasePort;
        IOPortList[nIdx].AltPort := uAltPort;
        Inc(nIdx);
        //**********************************************************************
      end
      else
        uAltPort := IODes.IOD_Alloc_End;
      if uAltPort - uBase = 7 then
      begin
        fStorPort := True;
        uBasePort := uBase;
      end;
      rdPrevResDes := 0;
      cmRet := CM_Get_Next_Res_Des(@rdPrevResDes, nextLogConf, dwResType, nil, 0);
      FreeMemory(pBuf);
      if cmRet <> CR_SUCCESS then
        Break
      else
      begin
        CM_Free_Res_Des_Handle(nextLogConf);
        nextLogConf := rdPrevResDes;
      end;
    end;
    CM_Free_Res_Des_Handle(nextLogConf);
    Inc(wIndex);
  end;
  Result := True;
end;

end.

